
#|____________________________________________________________________
 |
 |         RMDS.LSP - Replicated Multidimensional Scaling
 |    Performs Classical or Replicated metric or nonmetric MDS
 |        Uses Kruskal's secondary monotone transformation 
 |            and the Guttman-deLeeuw SMACOF algorithm
 |
 |              Copyright (c) 1997, Forrest W. Young
 |                (replaces the ViSta|MDS program)
 |
 |     PROTOTYPE, SLOTS, OPTIONS, ANALYSIS, REPORT, CREATE-DATA
 |____________________________________________________________________
 |#


(defproto rmds-model-proto
  '(data nstim nmats dimensions monotone iteration-report iteration-plot X D T-Data stress-list x-change-list s-change-list t-change-list
         niter min-stress min-stress-delta min-x-delta plot-obj-list
         stop-iterating stimulus-names xmatrix old-matrix prev-matrix prev-stress orig-matrix 
         orig-stress) () vista-analysis-plugin-object-proto)


(defmeth rmds-model-proto :data (&optional (matrix-list nil set))
"Args: (&optional matrix-list)
Sets or returns the list of data matrices."
  (if set (setf (slot-value 'data) matrix-list))
  (slot-value 'data))

(defmeth rmds-model-proto :nstim (&optional (number nil set))
"Args: (&optional number)
Sets or returns the number of stimuli (must be > 3)."
  (if set (setf (slot-value 'nstim) number))
  (slot-value 'nstim))

(defmeth rmds-model-proto :nmats (&optional (number nil set))
"Args: (&optional number)
Sets or returns the number of matrices (must be positive)."
  (if set (setf (slot-value 'nmats) number))
  (slot-value 'nmats))

(defmeth rmds-model-proto :dimensions (&optional (number nil set))
"Args: (&optional number)
Sets or returns the number of dimensions (must be positive)."
  (if set (setf (slot-value 'dimensions) number))
  (slot-value 'dimensions))

(defmeth rmds-model-proto :monotone (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns t or nil for monotonic transformation."
  (if set (setf (slot-value 'monotone) logical))
  (slot-value 'monotone))

(defmeth rmds-model-proto :iteration-report (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns t or nil for iteration-reporting."
  (if set (setf (slot-value 'iteration-report) logical))
  (slot-value 'iteration-report))

(defmeth rmds-model-proto :iteration-plot (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns t or nil for iteration-plotting."
  (if set (setf (slot-value 'iteration-plot) logical))
  (slot-value 'iteration-plot))

(defmeth rmds-model-proto :niter (&optional (number nil set))
"Args: (&optional number)
Sets or returns the maximum number of itertions stopping criterion."
  (if set (setf (slot-value 'niter) number))
  (slot-value 'niter))

(defmeth rmds-model-proto :min-stress (&optional (number nil set))
"Args: (&optional number)
Sets or returns the minimum acceptable stress stopping criterion."
  (if set (setf (slot-value 'min-stress) number))
  (slot-value 'min-stress))

(defmeth rmds-model-proto :min-stress-delta (&optional (number nil set))
"Args: (&optional number)
Sets or returns the minimum acceptable change in stress stopping criterion."
  (if set (setf (slot-value 'min-stress-delta) number))
  (slot-value 'min-stress-delta))

(defmeth rmds-model-proto :min-x-delta (&optional (number nil set))
"Args: (&optional number)
Sets or returns the minimum acceptable maximum absolute change in coordinate stopping criterion."
  (if set (setf (slot-value 'min-x-delta) number))
  (slot-value 'min-x-delta))

(defmeth rmds-model-proto :X (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns the current matrix of point coordinates."
  (if set (setf (slot-value 'X) matrix))
  (slot-value 'X))

(defmeth rmds-model-proto :Xmatrix (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns a copy the current matrix of point coordinates. Used for interactive graphical modelling"
  (if set (setf (slot-value 'Xmatrix) matrix))
  (slot-value 'Xmatrix))

(defmeth rmds-model-proto :old-matrix (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns a copy the old matrix of point coordinates. Used for interactive graphical modelling"
  (if set (setf (slot-value 'old-matrix) matrix))
  (slot-value 'old-matrix))

(defmeth rmds-model-proto :prev-matrix (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns a copy the prev matrix of point coordinates. Used for interactive graphical modelling"
  (if set (setf (slot-value 'prev-matrix) matrix))
  (slot-value 'prev-matrix))

(defmeth rmds-model-proto :prev-stress (&optional (value nil set))
"Args: (&optional matrix)
Sets or returns a copy the prev matrix of point coordinates. Used for interactive graphical modelling"
  (if set (setf (slot-value 'prev-stress) value))
  (slot-value 'prev-stress))

(defmeth rmds-model-proto :orig-matrix (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns a copy the original matrix of point coordinates. Used for interactive graphical modelling"
  (if set (setf (slot-value 'orig-matrix) matrix))
  (slot-value 'orig-matrix))

(defmeth rmds-model-proto :orig-stress (&optional (value nil set))
"Args: (&optional value)
Sets or returns a copy the original stress. Used for interactive graphical modelling"
  (if set (setf (slot-value 'orig-stress) value))
  (slot-value 'orig-stress))

(defmeth rmds-model-proto :D (&optional (matrix nil set))
"Args: (&optional matrix)
Sets or returns the current matrix of distances."
  (if set (setf (slot-value 'D) matrix))
  (slot-value 'D))

(defmeth rmds-model-proto :T-Data (&optional (matrix-list nil set))
"Args: (&optional matrix-list)
Sets or returns the list of transformed data matrices."
  (if set (setf (slot-value 'T-Data) matrix-list))
  (slot-value 'T-Data))

(defmeth rmds-model-proto :stress-list (&optional (number-list nil set))
"Args: (&optional number-list)
Sets or returns the list of stress values for each iteration."
  (if set (setf (slot-value 'stress-list) number-list))
  (slot-value 'stress-list))

(defmeth rmds-model-proto :x-change-list (&optional (number-list nil set))
"Args: (&optional number-list)
Sets or returns the list of x-change values for each iteration."
  (if set (setf (slot-value 'x-change-list) number-list))
  (slot-value 'x-change-list))

(defmeth rmds-model-proto :s-change-list (&optional (number-list nil set))
"Args: (&optional number-list)
Sets or returns the list of s-change values for each iteration."
  (if set (setf (slot-value 's-change-list) number-list))
  (slot-value 's-change-list))

(defmeth rmds-model-proto :t-change-list (&optional (number-list nil set))
"Args: (&optional number-list)
Sets or returns the list of t-change values for each iteration."
  (if set (setf (slot-value 't-change-list) number-list))
  (slot-value 't-change-list))

(defmeth rmds-model-proto :plot-obj-list (&optional (object-list nil set))
"Args: (&optional object-list)
Sets or returns the list of plot object identifications."
  (if set (setf (slot-value 'plot-obj-list) object-list))
  (slot-value 'plot-obj-list))

(defmeth rmds-model-proto :stop-iterating (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns t or nil to stop iterating."
  (if set (setf (slot-value 'stop-iterating) logical))
  (slot-value 'stop-iterating))

(defmeth rmds-model-proto :stimulus-names (&optional (stimulus-names nil set))
"Args: (&optional stimulus-names)
Sets or returns the list of labels of stimulus."
  (if set (setf (slot-value 'stimulus-names) stimulus-names))
  (slot-value 'stimulus-names))


(defmeth rmds-model-proto :options () 
  (when (send self :dialog)
  (let* ((result nil)
         (dimensions (send text-item-proto :new "Dimensions"))
         (anal-head (send text-item-proto :new "ANALYSIS OPTIONS"))
         (proc-opt (send text-item-proto :new "PROCESS OPTIONS"))
         (stop-opt (send text-item-proto :new "STOPPING RULES"))
         (monotone-toggle (send choice-item-proto 
                                :new (list "Nonmetric"
                                           "Metric") :value 0))
         (plot-toggle (send toggle-item-proto :new "Iteration Plots" 
                            :value t))
         (report-toggle (send toggle-item-proto :new "Report" 
                              :value (send self :iteration-report)))
         (num-iter (send text-item-proto :new         "Max. iterations   "))
         (min-stress (send text-item-proto :new       "Min. Stress       "))
         (min-stress-delta (send text-item-proto :new "Min. Stress Change"))
         (min-x-delta (send text-item-proto :new      "Min. Coord. Change"))
         (edit-dimensions (send edit-text-item-proto :new " 3"))
         (edit-num-iter (send edit-text-item-proto :new "30      "))
         (edit-min-stress (send edit-text-item-proto :new "0.01    "))
         (edit-min-stress-delta (send edit-text-item-proto :new "0.0001  "))
         (edit-min-x-delta (send edit-text-item-proto :new "0.001   "))
         (spacer1 (send text-item-proto :new "  "))
         (spacer2 (send text-item-proto :new "  "))
         (Ok (send modal-button-proto :new "OK" 
                   :action #'(lambda ()
                               (list
                                (send self :dimensions 
                                      (read-from-string
                                       (send edit-dimensions :text)))
                                (send self :niter
                                      (read-from-string 
                                       (send edit-num-iter :text)))
                                (send self :min-stress
                                      (read-from-string
                                       (send edit-min-stress :text)))
                                (send self :min-stress-delta
                                      (read-from-string
                                       (send edit-min-stress-delta :text)))
                                (send self :min-x-delta
                                      (read-from-string
                                       (send edit-min-x-delta :text)))
                                (send self :monotone
                                      (equal (send monotone-toggle :value) 0))
                                (send self :iteration-plot 
                                     	(send plot-toggle :value))
                               	(send self :iteration-report 
                                     	(send report-toggle :value))                    
                                ))))
         (cancel (send modal-button-proto :new "Cancel" 
                       :action #'(lambda () 
                                   (send dialog :modal-dialog-return nil))))
         (dialog
          (send modal-dialog-proto :new
                (list (list (list 
                             anal-head
                             (list edit-dimensions dimensions)
                             monotone-toggle
                             plot-toggle)
                            (list
                             stop-opt
                             (list num-iter edit-num-iter) 
                             (list min-stress edit-min-stress)
                             (list min-stress-delta edit-min-stress-delta)
                             (list min-x-delta edit-min-x-delta)
                             (list ok cancel)
                            )))))
         (a (send dialog :default-button ok))
         (input-options (send dialog :modal-dialog))
         )
    input-options)))

(defmeth rmds-model-proto :analysis ()
  ;(call-next-method)
  (send self :orig-stress (first (send self :stress-list)))
  (send self :nrmds)
  (send self :xmatrix (send self :x))
  ;(break)
  self
  )

(defmeth rmds-model-proto :nrmds ()
"Args: none
Does nonmetric (or metric) replicated (or unreplicated) MDS of symmetric data"
  (send self :initialize)
  (when (send self :iteration-plot) (send self :initialize-plots))
  (let* ((niter (send self :niter))
         (min-stress (send self :min-stress))
         (stress-list (send self :stress-list))
         (iteration-report (send self :iteration-report))
         (stress  (first (last (send self :stress-list))))
         (stress+ nil)
         (X  (send self :X))
         (X+ nil)
         )
    (when iteration-report
          (format t "~3%Iter   Stress    Stress   Max Abs")
          (format t "~%  0   ~7,5f   Improve   X-Change" stress))
    (when (and (> (first stress-list) min-stress)
               (> niter 0))
          (dotimes (iter niter)
                   (send self :iteration)
                   (when iteration-report
                         (setf X+ (send self :X))
                         (setf stress+ (first (last (send self :stress-list))))
                         (format t "~%~3d   ~7,5f   ~7,5f   ~7,5f " 
                                 (1+ iter) stress+ (- stress stress+) 
                                 (max (abs (- X X+)))))
                   (when (send self :stop-iterating)
                         (terpri)
                         (return))
                   (when iteration-report
                         (setf stress (first (last (send self :stress-list))))
                         (setf X (send self :X)))
                   ))
    t))

(defmeth rmds-model-proto :initialize () 
"Args: none
Initializes analysis using Torgerson MDS of RMS normalized data"
  (let* ((r (send self :dimensions))
         (m (send self :nmats))
         (O (send self :data))
         (TO (send self :zero-diagonal O))
         (TO (send self :norm-diss-data O))
         (TO-RMS (sqrt (/ (apply #'+ (^ TO 2)) m)))
         (X (send self :torgmds TO-RMS r))
         (D (distance-matrix X))
         (stress (send self :r-stress D TO))
         ) 
    (send self :X X)
    (send self :orig-matrix x)
    (send self :D D)
    (send self :T-Data TO)
    (send self :stress-list (list stress))
    t))

(defmeth rmds-model-proto :iteration ()
"Args: none
Performs one iteration using lsmt and smacof"
  (let* ((stress- (first (last (send self :stress-list))))
         (monotone (send self :monotone))
         (O (send self :data))
         (TO (send self :T-Data))
         (X (send self :X))
         (D (distance-matrix X))
         (data-list (send self :matrices-to-list TO))
         (dist-list (send self :matrices-to-list (list D)))
         (iteration-report (send self :iteration-report))
         (iteration-plot (send self :iteration-plot))
         (tran-list nil)
         (results nil)
         (stress nil)
         (x-change nil)
         (T+ nil)
         (X+ nil)
         (D+ nil)
         )
    (when monotone 
          (setf results (send self :r-LSMTransform O D))
          (setf T+ (first results))
          (send self :T-Data T+)
          (setf data-list (second results))
          (setf tran-list (third results))
          (setf dist-list (fourth results)))

    (setf X+ (send self :guttman-update X T+ D))
    (setf D+ (distance-matrix X+))
    (setf stress (send self :r-stress D+ T+))
    (setf s-change (- stress- stress))
    (setf t-change (/ (max (abs (- TO T+))) (max (abs TO))))
    (send self :X X+)
    (send self :xmatrix (send self :x)) ;pv
    (send self :D D+)
    (setf x-change (max (abs (- X+ X))))
    (send self :stress-list (combine (send self :stress-list) stress))
    (send self :s-change-list (combine (send self :s-change-list) s-change))
    (send self :x-change-list (combine (send self :x-change-list) x-change))
    (send self :t-change-list (combine (send self :t-change-list) t-change))

    (when iteration-plot (send self :update-plots 
                     (send self :plot-obj-list) 
                     data-list dist-list tran-list X+ monotone))
    (when (or (< stress (send self :min-stress))
              (< s-change (send self :min-stress-delta))
              (< x-change (send self :min-x-delta)))
          (send self :stop-iterating t)) 
    (send self :stop-iterating)
    (list data-list dist-list tran-list)))



(defmeth rmds-model-proto :initialize-plots ()
  (setf *nrmds-iterplot-container* (create-spreadplot-container))
  (let* ((X (send self :X))
         (dist-list (send self :matrices-to-list (list (send self :D))))
         (data-list (send self :matrices-to-list (send self :T-Data)))
         (monotone  (send self :monotone))
         (plots (send self :plot-obj-list 
                      (send self :make-plots X dist-list data-list monotone)))
         (scat  (select plots 0))
         (tran  (select plots 1))
         (fit   (select plots 2))
         (sd    (select plots 3))
         (xd    (select plots 4))
         (td    (select plots 5))
         (splot (if monotone
                      (spreadplot 
                       (matrix '(2 4) (list scat nil tran nil
                                            fit  sd  xd   td))
                       :span-right #2a((2 0 2 0) (1 1 1 1))
                       :span-down  #2a((1 0 1 0) (1 1 1 1))
                       :rel-heights '(2 1))
                      (spreadplot 
                       (matrix '(2 6) (list scat nil nil tran nil nil fit nil xd nil sd nil))
                       :span-right #2a((3 0 0 3 0 0) (2 0 2 0 2 0))
                       :span-down  #2a((1 0 0 1 0 0) (1 0 1 0 1 0 ))
                       :rel-heights '(3 2))
                      ))
         )
    (send scat :vista-look-and-feel)
    (send tran :vista-look-and-feel)
    (send fit  :vista-look-and-feel)
    (send sd   :vista-look-and-feel)
    (send xd   :vista-look-and-feel)
    (send td   :vista-look-and-feel)
    (send splot :show-spreadplot))
  t)

(defmeth rmds-model-proto :update-plots (plots data-list dist-list tran-list X+ monotone)
  (let ((m (/ (length (combine data-list)) (length (combine dist-list))))
        (scat  (select plots 0))
        (tran  (select plots 1))
        (fit   (select plots 2))
        (sd    (select plots 3))
        (xd    (select plots 4))
        (td    (select plots 5))
        (xp (first plots))
        (pp (second plots))
        (sp (third plots))
        (stress-list (send self :stress-list))
        (s-change-list (send self :s-change-list))
        (x-change-list (send self :x-change-list))
        (t-change-list (send self :t-change-list)))
    (send tran  :clear-points)
    (send tran  :add-points (combine data-list) (combine dist-list) :color 'blue)
    (send tran  :adjust-to-data)
    (when monotone 
          (send tran  :clear-lines)
          (mapcar #'(lambda (data t-data)
                      (send tran  :add-lines data t-data :color 'red)
                      )
                  data-list tran-list))
    (send scat :clear-points)
    (send scat :add-points (column-list X+) :color 'blue)
    (send fit  :clear-lines)
    (send fit  :add-lines (iseq (length stress-list)) stress-list  :color 'red) 
    (send sd   :clear-lines)
    (send sd   :add-lines (iseq (length s-change-list)) s-change-list :color 'red) 
    (send xd   :clear-lines)
    (send xd   :add-lines (iseq (length x-change-list)) x-change-list  :color 'red)
    (when monotone
          (send td   :clear-lines)
          (send td   :add-lines (iseq (length t-change-list)) t-change-list  :color 'red) )
    )
  )

(defmeth rmds-model-proto :make-plots (X+ dist-list data-list monotone)
  (let ((xp nil) (pp nil) (sp nil) (xd nil) (sd nil)
        (m (/ (length data-list) (length dist-list)))
        (td nil)
        )
    (setf xp (plot-points (column-list X+) :location (list 10 40)
                          :variable-labels (list "Dimension1" "Dimension2")))
    (send xp :range 0 -1 1)
    (send xp :range 1 -1 1)
    (send xp :x-axis t t 5)
    (send xp :y-axis t t 5)
    (send xp :title "MDS SPACE")
    (setf pp (plot-points data-list (repeat dist-list m)
                          :title "Scatterplot"
                          :location (list 300 40)
                          :variable-labels (list "Data" "Distances")))
    (when monotone 
          (send pp :variable-label 1 "Distances & Transformed Data")
          (send pp :title "Scatterplot & Transformations"))
    (setf sp (plot-points (list 0) (send self :stress-list)
                          :title "Stress Plot"
                          :location (list 10 320)
                          :variable-labels (list "Iteration" "Stress")))
    (send sp :range 0 0 (send self :niter))
    (send sp :range 1 0 .5)

    (setf xd (plot-points (list 0) (list 1) ;(send self :x-change-list)
                          :title "X-Change Plot"
                          :location (list 10 320)
                          :variable-labels (list "Iteration" "Coordinate Change")))
    (send xd :range 0 0 (send self :niter))
    (send xd :range 1 0 .1)
    (send Xd :y-axis t t 4)

    (setf sd (plot-points (list 0) (send self :stress-list)
                          :title "S-Change Plot"
                          :location (list 10 320)
                          :variable-labels (list "Iteration" "Stress Change")))
    (send sd :range 0 0 (send self :niter))
    (send sd :range 1 0 .1)
    (send Sd :y-axis t t 4)

    (when monotone
          (setf td (plot-points (list 0) (list 1) ;(send self :t-change-list);
                                :title "T-Change Plot"
                                :location (list 10 320)
                                :variable-labels (list "Iteration" "Transformation Change")))
          (send td :range 0 0 (send self :niter))
          (send td :range 1 0 .1)
          (send td :y-axis t t 4))

    (list xp pp sp sd xd td)))

(defmeth rmds-model-proto :report (&key (dialog nil))
  (if (not (eq current-object self)) (setcm self))
  (let* ((w nil)
         (stress-list (send self :stress-list))
         (x-change-list (send self :x-change-list))
         (stress (first (last stress-list)))
         (stimulus-names (send self :stimulus-names))
         (nstim (length stimulus-names))
         (ndim (send self :dimensions))
         (nmats (send self :nmats))
         )
    (setf w (report-header (send self :title)))
    (display-string (format nil "Replicated ~a Multidimensional Scaling~2%Model:      ~a~%Dimensions: ~d" (if (send self :monotone) "Nonmetric (Monotone)" "Metric (Linear)") (send self :name) ndim) w)
    (display-string (format nil "~%Minimum Stress:            ~9,6f" 
                            (fuzz (send self :min-stress) 5)) w)
    (display-string (format nil "~%Minimum Stress Change:     ~9,6f"
                            (fuzz (send self :min-stress-delta) 5)) w)
    (display-string (format nil "~%Minimum Coordinate Change: ~9,6f"
                            (fuzz (send self :min-x-delta) 5)) w)
    (display-string (format nil "~3%DATA LISTING") W)
    (mapcar #'(lambda (matrix mat-name i)
               (display-string (format nil "~%MATRIX ~d: ~a~%" (1+ i) mat-name) w)
               (print-matrix-to-window (fuzz matrix) w 
                                       :row-labels stimulus-names
                                       :column-labels stimulus-names))
           (send self :data) (send self :matrices) (iseq nmats))

    (display-string (format nil "~3%ITERATION REPORT") W)
    (mapcar #'(lambda (i)
               (case i
                 (0 
                  (display-string
                   (format nil "~%                           STRESS      MINIMUM ABSOLUTE") w)
                  (display-string
                   (format nil "~%  ITERATION    STRESS      CHANGE      COORDINATE CHANGE") w)
                  (display-string
                   (format nil "~%~11d    ~6,4f" 
                           i (fuzz (select stress-list i) 4)) w))
                 (t
                  (display-string
                   (format nil "~%~11d    ~6,4f    ~9,6f    ~9,6f"
                           i
                           (fuzz (select stress-list i) 4)
                           (fuzz (- (select stress-list (1- i) )
                                    (select stress-list i)) 8)
                           (fuzz (select x-change-list i) 6)) w))))
               (iseq (length stress-list)))

    
    (display-string (format nil "~3%STIMULUS COORDINATES~%") w)
    (print-matrix-to-window (fuzz (select (send self :xmatrix) (iseq nstim) (iseq ndim)) 4) w 
                            :row-labels stimulus-names
                            :col-labels (mapcar #'(lambda (i)
                                                    (format nil "Dim~a" (1+ i)))
                                                (iseq ndim))
                            )
    (send w :fit-window-to-text)
    (send w :scroll 0 0)
    w))

(defmeth rmds-model-proto :save-model-template (data-object)
"Args: (data-object)
DATA-OBJECT is the object-identification information of a data object. 
The method contains a template for saving the model-object."
  `(multidimensional-scaling
    :dialog nil
    :data (data ,(send data-object :name)
                :title ,(send data-object :title)
                :matrices ',(send self :matrices)
                :variables ',(send self :stimulus-names)
                :labels ',(send self :labels)
                :data ',(combine (send self :data)))
    :dimensions ,(send self :dimensions)
    :monotone ,(send self :monotone)
    :iteration-plot ,(send self :iteration-plot)
    :iteration-report ,(send self :iteration-report)
    :niter ,(send self :niter)
    :min-stress ,(send self :min-stress)
    :min-x-delta ,(send self :min-x-delta)
    :min-stress-delta ,(send self :min-stress-delta)
    ))


(defmeth rmds-model-proto :create-data 
  (&key (dialog nil)
        (coordinates T)
        (distances nil)
        (data nil)
        (transformed-data nil))
"Args: DIALOG (COORDINATES T) DISTANCES DATA TRANSFORMED-DATA
Creates output data objects. If DIALOG=T then presents dialog to determine which objects created. Otherwise presents specified objects. If no options, specified, creates only coordinates."
  (if (not (eq current-object self)) (setcm self)) 
  (let ((creator (send *desktop* :selected-icon))
        (desires (list (list (if coordinates 0) 
                             (if distances 1)
                             (if transformed-data 2)
                             (if data 3)
                             )))
        )
    (cond 
      (dialog
       (setf desires 
             (choose-subset-dialog "Choose Desired Data Objects"
                  '("Stimulus Coordinates"
                    "Fitted Distances"
                    "Transformed Data"
                    "Analyzed Input Data")
                   :initial (select desires 0))))
      (t
       (setf desires 
             (list (list (if coordinates 0)
                         (if dist 1)
                         (if data 2)
                         (if transformed-data 3))))))
    
    (when desires
          (when (member '0 (select desires 0))
                (send current-model :mds-space creator))
          (when (member '1 (select desires 0))
                (send current-model :mds-dist creator))
          (when (member '2 (select desires 0))
                (send current-model :mds-tdata  creator))
          (when (member '3 (select desires 0))
                (send current-model :mds-data  creator)))
    (not (not desires))))


(defmeth rmds-model-proto :mds-space (creator)
  (data (strcat "X-" (send self :name))
   :created creator
   :creator-object self
   :title (strcat "MDS Coordinates for " (send self :title))
   :data (combine (send self :X))
   :variables (mapcar #'(lambda (x) (format nil "PC~a" x)) 
                      (1+ (iseq (send self :dimensions))))
   :labels (send self :labels)
   :types (repeat "Numeric" (send self :dimensions))
  ))


(defmeth rmds-model-proto :mds-data (creator)
  (data (strcat "Data-" (send self :name))
   :created creator
   :creator-object self
   :title (strcat "Data Analyzed in MDS for " (send self :title))
   :data (combine (send self :data))
   :matrices (send self :matrices)
   :variables (send self :stimulus-names)
   :labels (send self :stimulus-names)
   :types (repeat "Numeric" (length (send self :stimulus-names)))
  ))

(defmeth rmds-model-proto :mds-tdata (creator)
  (data (strcat "Trnsf-" (send self :name))
   :created creator
   :creator-object self
   :title (strcat "Transformed Data from MDS of " (send (send self :data-object) :title))
   :data (combine (send self :t-data))
   :matrices (send self :matrices)
   :variables (send self :stimulus-names)
   :labels (send self :stimulus-names)
   :types (repeat "Numeric" (length (send self :stimulus-names)))
  ))


(defmeth rmds-model-proto :mds-dist (creator)
  (data (strcat "Dist-" (send self :name))
   :created creator
   :creator-object self
   :title (strcat "Distances from MDS of " (send (send self :data-object) :title))
   :data (combine (send self :D))
   :matrices (send self :matrices)
   :variables (send self :stimulus-names)
   :labels (send self :stimulus-names)
   :types (repeat "Numeric" (length (send self :stimulus-names)))
  ))